home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr11 / pcv05n12.zip / QFORM.BAS < prev    next >
BASIC Source File  |  1993-06-10  |  7KB  |  119 lines
  1. 100 'QFORM Ver. 3.0 Copyright William Barden, Jr. 1992
  2. 110 DIM C$(1): CLS : KEY OFF: C$ = STRING$(5280, " ")
  3. 120 X = 0: Y = 0: LINTYP = 0: PENT = 0: CLR = 0: MODE = 0: FT = 1: DS = 0
  4. 130 GOSUB 550
  5. 140 IF ZA <> 0 THEN ON ZA GOTO 160, 210, 260, 310, 360, 370, 380, 390, 430, 440, 480
  6. 150 IF ZA = 12 THEN SYSTEM ELSE GOTO 130
  7. 160 IF PENT = 0 THEN GOSUB 1100: GOTO 150
  8. 170 CC$ = CHR$(179 + 7 * LINTYP): PD = ZD: ZD = 1: IF FT = 1 THEN FT = 0: GOSUB 650: GOTO 150
  9. 180 GOSUB 650: GOSUB 1100: CLR = 0: IF Y = 0 AND DS = 0 THEN GOTO 150
  10. 190 IF MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = " " THEN MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = CHR$(179 + 7 * LINTYP)
  11. 200 GOTO 150
  12. 210 IF PENT = 0 THEN GOSUB 1150: GOTO 150
  13. 220 CC$ = CHR$(179 + 7 * LINTYP): PD = ZD: ZD = 2: IF FT = 1 THEN FT = 0: GOSUB 650: GOTO 150
  14. 230 GOSUB 650: GOSUB 1150: CLR = 0: IF Y = 23 AND DS = 42 THEN GOTO 150
  15. 240 IF MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = " " THEN MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = CHR$(179 + 7 * LINTYP)
  16. 250 GOTO 150
  17. 260 IF PENT = 0 THEN X = X - 1: IF X = -1 THEN X = 0: GOTO 150 ELSE GOTO 150
  18. 270 CC$ = CHR$(196 + 9 * LINTYP): PD = ZD: ZD = 3: IF FT = 1 THEN FT = 0: GOSUB 650: GOTO 150
  19. 280 GOSUB 650: X = X - 1: CLR = 0: IF X = -1 THEN X = 0: GOTO 150
  20. 290 IF MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = " " THEN MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = CHR$(196 + 9 * LINTYP)
  21. 300 GOTO 150
  22. 310 IF PENT = 0 THEN X = X + 1: IF X = 80 THEN X = 79: GOTO 150 ELSE GOTO 150
  23. 320 CC$ = CHR$(196 + 9 * LINTYP): PD = ZD: ZD = 4: IF FT = 1 THEN FT = 0: GOSUB 650: GOTO 150
  24. 330 GOSUB 650: X = X + 1: CLR = 0: IF X = 80 THEN X = 79: GOTO 150
  25. 340 IF MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = " " THEN MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = CHR$(196 + 9 * LINTYP)
  26. 350 GOTO 150
  27. 360 LINTYP = 0: PENT = 1: GOTO 150
  28. 370 LINTYP = 1: PENT = 1: GOTO 150
  29. 380 PENT = 0: GOTO 150
  30. 390 LOCATE 25, 1: PRINT "Text entry mode. Press % to end"; : ZXS = X
  31. 400 GOSUB 530: ZA$ = INKEY$: IF ZA$ = "" THEN GOTO 400 ELSE IF ZA$ = "%" THEN GOSUB 1070: GOTO 150
  32. 404 IF ZA$ <> CHR$(8) OR X = 0 GOTO 409
  33. 405 MID$(C$, ((Y + DS) * 80 + X), 1) = " ": LOCATE Y + 1, X: PRINT " ";
  34. 408 X = X - 1: GOTO 400
  35. 409 IF ZA$ = CHR$(13) THEN GOSUB 1150: X = ZXS: GOTO 400
  36. 410 IF LEN(ZA$) > 1 OR ZA$ < " " THEN GOTO 400
  37. 411 MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = ZA$: LOCATE Y + 1, X + 1: PRINT ZA$; : X = X + 1
  38. 420 IF X = 80 THEN X = 79: GOTO 400 ELSE GOTO 400
  39. 430 MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = " ": CLR = 1: GOSUB 670: GOTO 150
  40. 440 LOCATE 25, 1: PRINT "Save file as (Press Enter to cancel): "; : ZZ$ = "": INPUT ; "", ZZ$
  41. 450 IF ZZ$ = "" THEN GOSUB 1070: GOTO 150 ELSE OPEN "O", #1, ZZ$
  42. 460 FOR I = 0 TO 65: ZA$ = "": FOR J = 0 TO 79: ZA$ = ZA$ + MID$(C$, (I * 80 + J) + 1, 1): NEXT
  43. 470 PRINT #1, ZA$: NEXT: CLOSE : GOSUB 1070: GOTO 150
  44. 480 LOCATE 25, 1: PRINT "To read in a file, enter its name (press Enter to cancel): ";
  45. 490 INPUT ; "", ZZ$: IF ZZ$ = "" THEN GOSUB 1070: GOTO 150 ELSE OPEN "I", #1, ZZ$
  46. 500 CLS : KEY OFF: DS = 0: FOR I = 0 TO 65: IF EOF(1) THEN GOTO 511
  47. 501 LINE INPUT #1, ZA$: FOR J = 1 TO LEN(ZA$)
  48. 510 MID$(C$, (I * 80 + (J - 1)) + 1, 1) = MID$(ZA$, J, 1): NEXT: NEXT
  49. 511 CLOSE : FOR I = 0 TO 1919
  50. 520 LOCATE INT(I / 80) + 1, (I MOD 80) + 1: PRINT MID$(C$, I + 1, 1); : NEXT: GOTO 150
  51. 530 LOCATE Y + 1, X + 1: ZC$ = MID$(C$, ((Y + DS) * 80 + X) + 1, 1): PRINT CHR$(219);
  52. 540 LOCATE Y + 1, X + 1: PRINT ZC$; : RETURN
  53. 550 ZA$ = INKEY$: IF ZA$ = "" THEN GOSUB 530: GOTO 550 ELSE ZA = 0
  54. 560 IF MODE = 1 THEN GOTO 640
  55. 570 IF ZA$ = CHR$(0) + CHR$(72) THEN ZA = 1 ELSE IF ZA$ = CHR$(0) + CHR$(80) THEN ZA = 2
  56. 580 IF ZA$ = CHR$(0) + CHR$(75) THEN ZA = 3 ELSE IF ZA$ = CHR$(0) + CHR$(77) THEN ZA = 4
  57. 590 IF ZA <> 0 THEN GOTO 640
  58. 600 IF ZA$ = "s" OR ZA$ = "S" THEN ZA = 5 ELSE IF ZA$ = "d" OR ZA$ = "D" THEN ZA = 6
  59. 610 IF ZA$ = "p" OR ZA$ = "P" THEN ZA = 7 ELSE IF ZA$ = "t" OR ZA$ = "T" THEN ZA = 8
  60. 620 IF ZA$ = "c" OR ZA$ = "C" THEN ZA = 9 ELSE IF ZA$ = "w" OR ZA$ = "W" THEN ZA = 10
  61. 630 IF ZA$ = "n" OR ZA$ = "N" THEN ZA = 11 ELSE IF ZA$ = "x" OR ZA$ = "X" THEN ZA = 12
  62. 640 RETURN
  63. 650 ZB$ = MID$(C$, ((Y + DS) * 80 + X) + 1, 1)
  64. 660 IF ZB$ <> " " AND PENT = 1 AND CLR = 0 THEN GOTO 690
  65. 670 IF CLR <> 1 THEN MID$(C$, ((Y + DS) * 80 + X) + 1, 1) = CC$: LOCATE Y + 1, X + 1: PRINT CC$;
  66. 680 RETURN
  67. 690 CC$ = ZB$: BR = (ZD - 1) * 2 + LINTYP + 1
  68. 700 ON BR GOTO 710, 730, 750, 770, 790, 810, 830, 850
  69. 710 RESTORE 720: GOTO 870 'Up, single
  70. 720 DATA 184,181,191,180,194,197,196,197,205,207,209,216,213,198,218,195
  71. 730 RESTORE 740: GOTO 870 'Up, double
  72. 740 DATA 183,182,187,185,196,208,201,204,203,206,205,206,210,215,214,199
  73. 750 RESTORE 760: GOTO 870 'Down, single
  74. 760 DATA 190,181,192,195,193,197,196,197,205,209,207,216,212,198,217,180
  75. 770 RESTORE 780: GOTO 870 'Down, double
  76. 780 DATA 188,185,189,182,196,210,200,204,202,206,205,206,208,215,211,199
  77. 790 RESTORE 800: GOTO 870 'Left, single
  78. 800 DATA 179,197,186,182,192,193,195,197,199,215,211,208,214,210,218,194
  79. 810 RESTORE 820: GOTO 870 'Left, double
  80. 820 DATA 179,181,186,206,198,216,200,202,201,203,204,206,212,207,213,209
  81. 830 RESTORE 840: GOTO 870 'Right, single
  82. 840 DATA 179,197,180,197,182,215,183,210,186,199,189,208,191,194,217,193
  83. 850 RESTORE 860: GOTO 870 'Right, double
  84. 860 DATA 179,198,181,216,184,209,185,206,186,206,187,203,188,202,190,207
  85. 870 FOR ZI = 1 TO 8: READ ZF, ZT: ZF$ = CHR$(ZF): ZT$ = CHR$(ZT)
  86. 880 IF ZF$ <> CC$ THEN GOTO 1060
  87. 890 IF ZD = 4 AND CC$ = CHR$(179) AND PD = 1 THEN ZT$ = CHR$(218)
  88. 900 IF ZD = 4 AND CC$ = CHR$(179) AND PD = 2 THEN ZT$ = CHR$(192)
  89. 910 IF ZD = 3 AND CC$ = CHR$(179) AND PD = 1 THEN ZT$ = CHR$(191)
  90. 920 IF ZD = 3 AND CC$ = CHR$(179) AND PD = 2 THEN ZT$ = CHR$(217)
  91. 930 IF ZD = 1 AND CC$ = CHR$(196) AND PD = 3 THEN ZT$ = CHR$(192)
  92. 940 IF ZD = 1 AND CC$ = CHR$(196) AND PD = 4 THEN ZT$ = CHR$(217)
  93. 950 IF ZD = 2 AND CC$ = CHR$(196) AND PD = 3 THEN ZT$ = CHR$(218)
  94. 960 IF ZD = 2 AND CC$ = CHR$(196) AND PD = 4 THEN ZT$ = CHR$(191)
  95. 970 IF ZD = 4 AND CC$ = CHR$(186) AND PD = 1 THEN ZT$ = CHR$(201)
  96. 980 IF ZD = 4 AND CC$ = CHR$(186) AND PD = 2 THEN ZT$ = CHR$(200)
  97. 990 IF ZD = 3 AND CC$ = CHR$(186) AND PD = 1 THEN ZT$ = CHR$(187)
  98. 1000 IF ZD = 3 AND CC$ = CHR$(186) AND PD = 2 THEN ZT$ = CHR$(188)
  99. 1010 IF ZD = 1 AND CC$ = CHR$(205) AND PD = 3 THEN ZT$ = CHR$(200)
  100. 1020 IF ZD = 1 AND CC$ = CHR$(205) AND PD = 4 THEN ZT$ = CHR$(188)
  101. 1030 IF ZD = 2 AND CC$ = CHR$(205) AND PD = 3 THEN ZT$ = CHR$(201)
  102. 1040 IF ZD = 2 AND CC$ = CHR$(205) AND PD = 4 THEN ZT$ = CHR$(187)
  103. 1050 CC$ = ZT$: GOTO 670
  104. 1060 NEXT ZI: GOTO 670
  105. 1070 LOCATE 25, 1
  106. 1080 PRINT "                                                                  ";
  107. 1090 RETURN
  108. 1100 Y = Y - 1: IF (Y > -1) THEN RETURN ELSE IF (Y = -1 AND DS = 0) THEN Y = 0: RETURN
  109. 1110 IF DS = 42 THEN DS = 21 ELSE DS = 0
  110. 1120 CLS : KEY OFF: FOR I = 0 TO 1919: ZK$ = MID$(C$, (I + (DS * 80)) + 1, 1)
  111. 1130 IF ZK$ <> " " THEN LOCATE INT(I / 80) + 1, (I MOD 80) + 1: PRINT ZK$;
  112. 1140 NEXT: Y = 21: RETURN
  113. 1150 Y = Y + 1: IF (Y < 24) THEN RETURN ELSE IF (Y = 24 AND DS = 42) THEN Y = 23: RETURN
  114. 1160 IF DS = 0 THEN DS = 21 ELSE DS = 42
  115. 1170 CLS : KEY OFF: FOR I = 0 TO 1919: ZK$ = MID$(C$, (I + (DS * 80)) + 1, 1)
  116. 1180 IF ZK$ <> " " THEN LOCATE INT(I / 80) + 1, (I MOD 80) + 1: PRINT ZK$;
  117. 1190 NEXT: Y = 2: RETURN
  118.  
  119.